home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / TSR.SWG / 0018_TSR Disk Writes.pas < prev    next >
Pascal/Delphi Source File  |  1994-01-27  |  2KB  |  81 lines
  1. {
  2. >Does anybody know how to write to disk inside a TSR using
  3. >turbo pascal?  I know all about how to write a simple TSR,
  4. >cannot call Dos functions from within a hardware interrupt.
  5.  
  6. Here is parts of a tsr to write to disk when a hotkey is pressed
  7. (Leftshift,left alt,right alt)
  8. }
  9.  
  10. uses dos,crt;
  11. const
  12.  hotkey : byte = 5;
  13.  writekey : byte = 10; {write to disk when this combo comes up }
  14. var
  15.   dat : file of word;  {keep file definition on globals}
  16.  
  17. procedure diskit;
  18. var
  19.     x,y : word;
  20. begin
  21.   if not cracking then
  22.   begin
  23.     cracking := true;  {disable checking for hotkey while writing}
  24.     assign(dat,'a:\dump.scr');
  25.     rewrite(Dat);
  26.     display;
  27.     for y := 0 to 24 do
  28.       for x := 0 to 79 do
  29.       write(dat,wind[X,y]);
  30.     close(dat);
  31.     current := 1;        {Reset current to 0}
  32.     cracking := false;
  33.   end;
  34. end;
  35. {------------------------------------------------------------}
  36. procedure calloldint(sub:pointer);
  37. begin {calloldint}
  38. inline($9C/$FF/$5E/$06);   {Assembly to pop pointer off stack and call it}
  39. end; {calloldint}
  40. {-------------------------------------------------------------}
  41.  
  42. procedure tick(flags,cs,ip,ax,bx,cx,dx,si,di,ds,es,bp:word); interrupt;
  43. var regs:registers;
  44. begin
  45. calloldint(oldvec);
  46.    regs.ah := $12;
  47.    intr($16, regs);
  48.    statflags := (regs.al and  regs.ah) and hotkey;
  49.    regflags := (regs.al and  regs.ah) and writekey;
  50. if (statflags = hotkey) and (cnt =0) then
  51.   begin
  52.   cnt := 1;
  53.   display;
  54.   cnt := 0;
  55.   end
  56. else if (regflags = writekey) and (cnt = 0) then
  57.   begin
  58.    cnt := 1;
  59.    diskit;     {write to disk if hotkey}
  60.    cnt := 0;
  61.   end
  62. else inline($FB);
  63. end; {tick}
  64. {-----------------------------------------------------}
  65.  
  66. begin {MAIN}
  67. writeln('Saving screens function activated');
  68. current := 1;
  69. getintvec($08,oldvec);
  70. setintvec($08,@tick);
  71. getintvec($09,oldkbdvec);
  72. setintvec($09,@keyboard);
  73. cnt := 0;
  74. Cracking := false;
  75. keep(0);
  76. end. {MAIN}
  77.  
  78. {
  79. This will work for writing to disk as long as no other disk activity is being
  80. performed.
  81. }